home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 6
/
FM Towns Free Software Collection 6.iso
/
t_os
/
mtcnv
/
mtcnv43d.bas
next >
Wrap
BASIC Source File
|
1993-07-08
|
6KB
|
135 lines
100 '==================================
110 '
120 ' MSX→TOWNS グラフィック コンバーター Ver 4.3d
130 ' BSAVE形式→TIFF形式
140 ' (FILES版) Programed by YAZ
150 '==================================
1000 CLEAR ,,,70000:SCREEN@ 0:COLOR 7,0,7,0:PALETTE:CONSOLE 0,24,2
1010 DEFINT A-Z:DEFLNG F,M,P:DIM GRPDAT(256),IMA(27136),C(3,2)
1020 P=VARPTR(GRPDAT(0))
1030 *INIT
1040 SCREEN@ 0:CLS
1050 FOR I=0 TO 256:GRPDAT(I)=0:NEXT:DR$="":WILD$="":SDR$=""
1060 PRINT "読み込むドライブ ( A-Q ) :";:DR$=INPUT$(1):PRINT DR$
1070 IF (DR$<"A" OR "Q"<DR$) AND (DR$<"a" OR "q"<DR$) THEN 1060
1080 INPUT "ワイルドカード :",WILD$
1090 IF WILD$="" THEN WILD$=DR$+":*.*" ELSE WILD$=DR$+":"+WILD$
1100 ON ERROR GOTO 2270
1110 FILES WILD$
1120 ON ERROR GOTO 0
1130 INPUT"ファイルネーム : ";NME$
1140 IF NME$="" OR INSTR(NME$," ") OR LEN(NME$)>18 THEN 1130
1150 PRINT "スクリーンモード ( 1:SCREEN_5 2:SCREEN_6 3:SCREEN_7 4:SCREEN_8 5:19268色 )":PRINT ": ";
1160 A$=INPUT$(1):PRINT A$
1170 IF A$<"1" OR "5"<A$ THEN 1150
1180 IF A$="1" THEN SCRMODE=1:REP=256/2:S_SIZE=1
1190 IF A$="2" THEN SCRMODE=2
1200 IF A$="3" THEN SCRMODE=3:REP=512/2:S_SIZE=2
1210 IF A$="4" THEN SCRMODE=4
1220 IF A$="5" THEN SCRMODE=5
1230 MA_SK=0:INPUT"スキップバイト数";MA_SK
1240 PRINT "保存するドライブ ( A-P ) :";:SDR$=INPUT$(1):PRINT SDR$
1250 IF (SDR$<"A" OR "P"<SDR$) AND (SDR$<"a" OR "p"<SDR$) THEN 1240
1260 PRINT "全てよろしいですか? ( Y/N ) : ";:A$=INPUT$(1):PRINT A$
1270 IF A$="N" OR A$="n" THEN *INIT ELSE IF A$<>"Y" AND A$<>"y" THEN 1260
1280 *CONV
1290 ON ERROR GOTO 2270
1300 OPEN "I",#1,DR$+":"+NME$
1310 ON ERROR GOTO 0
1320 S$=INPUT$(1,#1):'IF ASC(S$)<>254 THEN PRINT "ファイルモードが違います" :CLOSE #1:BEEP:WAIT 80:GOTO *INIT '<---ファイルモードチェッカ
1330 MA_SI=ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))*256
1340 MA_SI=ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))*256-MA_SI-MA_SK
1350 S$=INPUT$(2+MA_SK,#1)
1360 CLS:ON SCRMODE GOSUB *SCR_5・7,*SCR_6,*SCR_5・7,*SCR_8,*SCR_12
1370 *SAVE
1380 X=0:Y=0
1390 IF SCRMODE=2 OR SCRMODE=3 THEN SX=511:SY=423 ELSE SX=255:SY=211
1400 LOCATE 14,22:PRINT USING"X=### Y=### SX=### SY=###";X;Y;SX;SY
1410 LINE (X,Y)-(SX,SY),XOR,7,B
1420 XX=X:YY=Y:SXX=SX:SYY=SY
1430 A$=INKEY$
1440 IF NOT((CHR$(27)<=A$ AND A$<=CHR$(31)) OR A$="2" OR A$="4" OR A$="6" OR A$="8" OR A$=CHR$(13)) THEN 1430
1450 X=X+(A$="4" AND X>0)-(A$="6" AND X<SX)
1460 Y=Y+(A$="8" AND Y>0)-(A$="2" AND Y<SY)
1470 SX=SX+(A$=CHR$(29) AND SX>X)- (A$=CHR$(28) AND SX<(-639\((SCRMODE=5)-1)))
1480 SY=SY+(A$=CHR$(30) AND SY>Y)- (A$=CHR$(31) AND SY<(-479\((SCRMODE=5)-1)))
1490 IF A$=CHR$(27) THEN *INIT
1500 LINE (XX,YY)-(SXX,SYY),XOR,7,B
1510 IF A$<>CHR$(13) THEN 1400
1520 SAVE@ SDR$+":"+LEFT$(NME$,INSTR(NME$,"."))+"TIF",(X,Y)-(SX,SY)
1530 GOTO *INIT
1540 *SCR_5・7
1550 LOCATE 0,22:PRINT "[ESC]=中止"
1560 Y=0:ES=0:FS=MA_SI-REP*Y
1570 WHILE FS>0 AND ES=0
1580 IF INKEY$=CHR$(27) THEN ES=-1:GOTO 1650
1590 IF FS>=REP THEN S$=INPUT$(REP-1,#1):S1$=INPUT$(1,#1) ELSE S$=INPUT$(FS,#1):S$=S$+STRING$(REP-1-LEN(S$),0):S1$=CHR$(0)
1600 FOR J=1 TO REP-1
1610 POKE P+J-1,ASC(MID$(S$,J,1))\16+(ASC(MID$(S$,J,1)) AND 15)*16
1620 NEXT:POKE P+REP-1,ASC(S1$)\16+(ASC(S1$) AND 15)*16
1630 PUT@A (0,Y*S_SIZE)-(REP*2-1,Y*S_SIZE),GRPDAT,,,S_SIZE
1640 Y=Y+1:FS=MA_SI-REP*Y
1650 WEND:CLOSE
1660 IF ES=-1 THEN LOCATE 0,22:PRINT "中止します。":WAIT 80:RETURN *INIT
1670 RETURN
1680 *SCR_6
1690 LOCATE 0,22:PRINT "[ESC]=中止"
1700 Y=0:ES=0:FS=MA_SI-128*Y
1710 WHILE FS>0 AND ES=0
1720 IF INKEY$=CHR$(27) THEN ES=-1:GOTO 1810
1730 IF FS>=128 THEN S$=INPUT$(128,#1) ELSE S$=INPUT$(FS,#1): S$=S$+STRING$(128-LEN(S$),0)
1740 FOR J=1 TO 128
1750 AS=ASC(MID$(S$,J,1))
1760 POKE P+J*2-2,AS \64+(AS \16 AND 3)*16
1770 POKE P+J*2-1,(AS \ 4 AND 3)+(AS AND 3)*16
1780 NEXT
1790 PUT@A (0,Y*2)-(511,Y*2),GRPDAT,,,2
1800 Y=Y+1:FS=MA_SI-128*Y
1810 WEND:CLOSE
1820 IF ES=-1 THEN LOCATE 0,22:PRINT "中止します。":WAIT 80:RETURN *INIT
1830 RETURN
1840 *SCR_8
1850 SCREEN@ 2:LOCATE 0,22:PRINT "[ESC]=中止"
1860 Y=0:ES=0:FS=MA_SI-256*Y
1870 WHILE FS>0 AND ES=0
1880 IF INKEY$=CHR$(27) THEN ES=-1:GOTO 1950
1890 IF FS>=256 THEN S$=INPUT$(255,#1):S1$=INPUT$(1,#1) ELSE S$=INPUT$(FS,#1):S$=S$+STRING$(255-LEN(S$),0):S1$=CHR$(0)
1900 FOR J=1 TO 255
1910 POKE P+J-1,ASC(MID$(S$,J,1))
1920 NEXT:POKE P+255,ASC(S1$)
1930 PUT@A (0,Y)-(255,Y),GRPDAT
1940 Y=Y+1:FS=MA_SI-256*Y
1950 WEND:CLOSE
1960 IF ES=-1 THEN LOCATE 0,22:PRINT "中止します。":WAIT 80:RETURN *INIT
1970 RETURN
1980 *SCR_12
1990 GOSUB *SCR_8
2000 GET@A (0,0)-(255,211),IMA
2010 SCREEN@ 1:CLS:LOCATE 0,22:PRINT "[ESC]=中止"
2020 FOR H=0 TO 211
2030 IF INKEY$=CHR$(27) THEN H=211:NEXT:LOCATE 0,22:PRINT "中止します。": WAIT 80:GOTO *INIT
2040 FOR I=0 TO 126 STEP 2
2050 FSUB0=IMA(H*128+I)-(IMA(H*128+I)<0)*65536
2060 FSUB1=IMA(H*128+I+1)-(IMA(H*128+I+1)<0)*65536
2070 Y0=(FSUB0 \ 8)AND 31:Y1=(FSUB0 \ 2048)AND 31
2080 Y2=(FSUB1 \ 8)AND 31:Y3=(FSUB1 \ 2048)AND 31
2090 K=((FSUB0 \ 32)AND 56)+(FSUB0 AND 7):K=K+(K>31)*64
2100 J=((FSUB1 \ 32)AND 56)+(FSUB1 AND 7):J=J+(J>31)*64
2110 C(0,0)=Y0+K:C(0,1)=Y0+J:C(0,2)=Y0*5/4-J\2-K\4
2120 C(1,0)=Y1+K:C(1,1)=Y1+J:C(1,2)=Y1*5/4-J\2-K\4
2130 C(2,0)=Y2+K:C(2,1)=Y2+J:C(2,2)=Y2*5/4-J\2-K\4
2140 C(3,0)=Y3+K:C(3,1)=Y3+J:C(3,2)=Y3*5/4-J\2-K\4
2150 FOR L=0 TO 3
2160 FOR M=0 TO 2
2170 IF C(L,M)<0 THEN C(L,M)=0
2180 IF C(L,M)>31 THEN C(L,M)=31
2190 NEXT:NEXT
2200 POKE P+I*4 ,C(0,0)*1024+C(0,1)*32+C(0,2),2
2210 POKE P+I*4+2,C(1,0)*1024+C(1,1)*32+C(1,2),2
2220 POKE P+I*4+4,C(2,0)*1024+C(2,1)*32+C(2,2),2
2230 POKE P+I*4+6,C(3,0)*1024+C(3,1)*32+C(3,2),2
2240 NEXT
2250 PUT@A (0,H)-(255,H),GRPDAT
2260 NEXT:RETURN
2270 PRINT "該当ファイルなし":BEEP:WAIT 80:RESUME *INIT